;; se-doc.el -*-emacs-lisp-*- -*-coding: iso-2022-7bit; -*-
;;; document browser for Emacs 20
;;; Author: Shuji Narazaki (narazaki@InetQ.or.jp)
;;; Time-stamp: <2008-04-14 09:26:33 narazaki@cs.cis.nagasaki-u.ac.jp>
;;; Keywords: text

;;; Commentary:
;;; Emacs lisp$BHGJ8>O?dZJ;Y1g%W%m%0%i%`(B

;;; Code:
(defconst se-doc/version "Summary-Edit based Document Checker Version 1.4.4")
(message se-doc/version)(sit-for 0)
(require 'summarye)
;; This package uses push, member, which are defined in cl package.
;; But since summarye uses dotimes, this package does not require cl package.
(eval-when-compile
  (require 'summarye))

(defconst se-doc/any "*$BG$0UJ8;zNs(B")
(defconst se-doc/stail "e$BJ8Kv(B")
(defconst se-doc/paragraph "p$B%Q%i%0%i%U(B")
(defconst se-doc/shead "s$BJ8F,(B")

(defvar se-doc/category-list (list se-doc/shead se-doc/stail se-doc/paragraph))

(defvar se-doc/item-delimiter-regexp nil)
(defvar se-doc/tmp nil)
(defvar se-doc/category-method nil)
(defvar se-doc/*method-cache* nil)
(defvar se-doc/item-documentation nil)
(defvar se-doc/show-at-second-line (list se-doc/paragraph))

(defun se-doc/check-document (cat &optional widen)
  (interactive 
   (list 
    (completing-read 
     (if se-doc/*method-cache*
	 (concat "Category (default " (car se-doc/*method-cache*) "): ")
       "Category: ")
     se-doc/item-delimiter-regexp nil (if se-doc/*method-cache* t 'cant-exit))
    (prefix-numeric-value current-prefix-arg)))
  (if (string-equal cat "")
      (setq cat (car se-doc/*method-cache*))
    (setq se-doc/*method-cache* (assoc cat se-doc/category-method)))
  (if (string-equal cat se-doc/any) (setq cat t))
  (se/make-summary-buffer
   cat widen nil se-doc/item-delimiter-regexp
   (cdr se-doc/*method-cache*)
   (function (lambda ()
	       (setq se-doc/tmp nil)
	       (if (member se/summary-category se-doc/show-at-second-line)
		   (se/set se/scroll-when-show 0))
	       (if (assoc se/summary-category se-doc/item-documentation)
		   (se/set se/item-documentation
			   (cdr (assoc se/summary-category 
				       se-doc/item-documentation))))
	       ;(setq mode-line-buffer-identification '("$B?dZJ(B:" " %20b"))
	       ))))

;;;
;;; method
;;; 
(defun se-doc/define-category (category &rest patterns)
  "define CATEGORY (symbol) that matches PATTERN (regexp string).
If 2nd arg is nil or t, then it is interpreted the case-fold flag and the
3rd arg is used for PATTERN. The value of case-fold flag affects the
result of the method for the category."
  (let* ((case-fold (if (symbolp (car patterns)) (pop patterns)))
	 (def (cons (let ((str (apply (function concat) patterns)))
		      str)
		    case-fold))
	 (cat.def (assoc category se-doc/item-delimiter-regexp)))
    (if cat.def
	(setcdr cat.def def)
      (push (cons category def) se-doc/item-delimiter-regexp))))

(defmacro se-doc/define-method (category &rest f)
  `(let ((fun (if (and (or (stringp (quote ,(car f)))
			   (symbolp (quote ,(car f)))))
		  (if (assoc ,(car f) se-doc/category-method)
		      (cdr (assoc ,(car f) se-doc/category-method))
		    (error "Method for %s is not defined: %s" 
			   ,category ,(car f)))
		(function ,(cons 'lambda f))))
	 (cat.def (assoc ,category se-doc/category-method)))
     (if cat.def
	 (setcdr cat.def fun)
       (push (cons ,category fun) se-doc/category-method))
     (setq se-doc/*method-cache* nil)))

(defun se-doc/define-documentation (category string)
  (let ((cat.def (assoc category se-doc/item-documentation)))
    (if cat.def
	(setcdr cat.def string)
      (push (cons category string) se-doc/item-documentation))))

;; marker is a local variable in se/search-next-cluster(dynamic scope!)
;; it is a marker set to the start point of cluster.
(defvar marker)
(defvar se-doc/frame-width-max 100)
(defconst se-doc/sentence-end	; one group
  "\\(\n[ 	$B!!(B]*\n\\|[.?!$B!*!)(B][ 	$B!!(B\n]\\|$B!%(B\\|$B!#(B\\|\\'\\)")
(defconst se-doc/sentence-end-	; for backward searach
  "\\(\n[ 	$B!!(B]*\n\\|[.?!$B!*!)(B][ 	$B!!(B\n]\\|$B!%(B\\|$B!#(B\\|\\`\\)")

;; * $BG$0UJ8;zNs(B
(se-doc/define-category se-doc/any)
 
;;; * $BJ8F,(B
;; 0.99.8$B$G$ODL?.Gr=q$KBP$7$F(B6:54(2024$B8D(B)
;; regexp$B$N=q$-49$((B  4:45(2047$B8D(B)
;; limit 100$B$X$NJQ99(B 0:34(2047$B8D(B)
;; $B$5$i$K>e8BCM$NKd$a9~$_(B(mule2$B$G$O@5$7$$(Bcharacter boundary$B$K$$$J$/$F$b!$(B
;; goto-char$B$d(Bbuffer-substring$B$,@5$7$$(Bcharacter boundary$B$K$$$k$+$N$h$&$K?6(B
;; $BIq$C$F$/$l$k(B):    0:26
(se-doc/define-category se-doc/shead se-doc/sentence-end)

(se-doc/define-method se-doc/shead (beg end cat)
  (let ((b (if (numberp se-doc/tmp)
	       se-doc/tmp
	     (se-doc/skip-whitespace (point-min)))))
    (goto-char (setq se-doc/tmp (se-doc/skip-whitespace end)))
    (set-marker marker b)
    (se/set-face b end)
    (se-doc/simple-display-string 
     (buffer-substring-no-properties b (min end (+ b se-doc/frame-width-max))))))

(se-doc/define-documentation se-doc/shead "
$B8=:_$N<BAu$G$O1QJ8Cf$N(Bi.e. $B$d(Bf.e.$B$r<h$j07$&$3$H$O:$Fq!%<BAu$9$k5$$O$J$$!%(B")

;; * $BJ8Kv(B
(se-doc/define-category se-doc/stail se-doc/sentence-end)

(se-doc/define-method se-doc/stail (beg end cat)
  (if (eobp)
      nil
    (let* ((s-beg (se-doc/this-sentence-beg beg se-doc/frame-width-max))
	   (sentence (buffer-substring-no-properties s-beg end)))
      (set-marker marker s-beg)
      (setq sentence (se-doc/strip-latex (se-doc/canonical-sentence sentence)))
      (goto-char (se-doc/skip-whitespace end))
      (se-doc/tail-display-string sentence))))

;; * $B%Q%i%0%i%U$N@hF,J8(B
(se-doc/define-category se-doc/paragraph 
  ;; "\\(\\`\\|\\(\n[ 	$B!!(B]*\\)+\n[ 	$B!!(B]*\\|^[ 	$B!!(B]+\\|\\'\\)" plain$BF|K\8l8~$1(B
  "\\(\\`\\|\\(\n[ 	$B!!(B]*\\)+\n[ 	$B!!(B]*\\|^$B!!(B\\|\\'\\)") ; TeX$B8~$1(B($B$3$C$A$,%G%U%)!<%k%H(B)

(se-doc/define-method se-doc/paragraph (beg end cat)
  (unless (eobp) 
    (let* ((b (se-doc/skip-whitespace beg))
	   (e (se-doc/this-sentence-end b se-doc/frame-width-max)))
      (set-marker marker b)
      (se/set-face b e nil nil)
      (goto-char (se-doc/skip-whitespace e t))
      (and (= (char-before (point)) ?\n)
	   (not (bobp))
	   (backward-char 1))
      (se-doc/simple-display-string (buffer-substring-no-properties b e)))))

(se-doc/define-documentation se-doc/paragraph "
   * You will certainly suffer from writer's block at some point. Writer's
     block has many sources and no sure cure. Perfectionism can lead to
     writer's block: whatever you start to write seems not good enough. 
     Realize that writing is a debugging process. Write something sloppy
     first and go back and fix it up.  Starting sloppy gets the ideas out
     and gets you into the flow. If you \"can't\" write text, write an
     outline. Make it more and more detailed until it's easy to write the
     subsubsubsections. If you find it really hard to be sloppy, try
     turning the contrast knob on your terminal all the way down so you
     can't see what you are writing. Type whatever comes into your head,
     even if it seems like garbage. After you've got a lot of text out,
     turn the knob back up and edit what you've written into something
     sensible.  Another mistake is to imagine that the whole thing can be
     written out in order.  Usually you should start with the meat of the
     paper and write the introduction last, after you know what the paper
     really says. Another cause of writer's block is unrealistic
     expectations about how easy writing is.  Writing is hard work and
     takes a long time; don't get frustrated and give up if you find you
     write only a page a day.

   * After you have written a paper, delete the first paragraph or the
     first few sentences. You'll probably find that they were content-free
     generalities, and that a much better introductory sentence can be
     found at the end of the first paragraph of the beginning of the
     second.
				-- from How To do Research at MIT AI Labs.

plain$BF|K\8lJ8>O$N9TF,$N6uGr$r$b$C$FCJMn$N3+;O$H8+$J$9$H$$$&@5=qK!$O%5%]!<(B
$B%H$7$F$$$J$$!%(B1$B9T6u$1$m!%(B")

;;;
;;; library function
;;;
(defun se-doc/canonical-sentence (str)
  (se/string-subst-char 
   ?\  ?\n
   (se/remove-regexp-in-string  "\n\n+\\|  +\\|	+\\| $" str)))

(defun se-doc/strip-latex (str)
  (se/remove-regexp-in-string
   "\\\\\\(begin\\|end\\){[^}]+}\\W+\\|\\\\item\\W+" str))

(defun se-doc/legal-position (pos dir)
  (let ((mc-header 160)
	(mc-flag nil))
    (while (< mc-header (char-after pos)) (setq pos (+ pos dir)))
    pos))

(defun se-doc/last-sentence-end (from &optional limit)
  (let (tmp)
    (save-excursion
      (goto-char from)
      (re-search-backward se-doc/sentence-end-)
      (setq tmp (match-end 0))
      (if limit
	  (setq tmp (max (point-min) (- from limit) tmp)))
      (if (= tmp (- from limit))
	  (se-doc/legal-position tmp -1)
	tmp))))

(defun se-doc/this-sentence-end (from &optional limit)
  (let (tmp)
    (save-excursion
     (goto-char from)
     (re-search-forward se-doc/sentence-end)
     (setq tmp (match-end 0))
      (if limit
	  (setq tmp (min (point-max) (+ from limit) tmp)))
      (if (= tmp (+ from limit))
	  (se-doc/legal-position tmp -1)
	tmp))))

(defun se-doc/skip-whitespace (from &optional backward-p)
  (save-excursion
    (goto-char from)
    (if backward-p
	(while (and (not (bobp))	; [Fri Mar 17 14:58:34 1995]
		    (memq (char-before (point)) '(?\  ?\t ?\n)))
	  (backward-char 1))
      (if (looking-at "[ $B!!(B\t\n]+")
	  (goto-char (match-end 0))))
    (point)))

(defun se-doc/this-sentence-beg (from &optional limit)
  (let ((last-end (se-doc/last-sentence-end from limit)))
    (se-doc/skip-whitespace last-end)))

(defun se-doc/simple-display-string (matched)
  (setq matched (se-doc/strip-latex (se-doc/canonical-sentence matched)))
  (if (string-equal matched "")
      nil
    matched))

(defun se-doc/tail-display-string (matched)
  (setq matched (se-doc/strip-latex (se-doc/canonical-sentence matched)))
  (let ((name-width (- (frame-width) 16)))
    (if (< name-width (string-width matched))
	(setq matched (se/string-cut-down-to matched name-width 'from-head)))
    (if (< (string-width matched) name-width)
	(setq matched
	      (concat (make-string (- name-width (string-width matched)) ?\ )
		      matched))))
  (if (string-equal matched "")
      nil
    matched))

;; * menu support
(defvar se-doc/menu-map (make-sparse-keymap "Check Document..."))
(or (fboundp 'define-menu-order)
(defun define-menu-order (map key &rest menu-items)
  "Define menu on MAP at KEY."
  (let ((menu (if key (lookup-key map key) map))	; might return a number as fail value
	tmp)
    (if (and menu (not (eq menu 'undefined)) (not (numberp menu)))
	(when (stringp (car menu-items))
	  (pop menu-items)
	  (if (stringp (car menu-items)) (pop menu-items)))
      (when (and (stringp (car menu-items))
		 (or (not (numberp menu)) (= menu 1)))
	(let* ((name (pop menu-items))
	       (title (if (stringp (car menu-items)) (pop menu-items) name)))
	  (define-key map key (cons name (make-sparse-keymap title)))
	  (setq menu (lookup-key map key)))))
    (when menu
      (while menu-items
	(push (list (car menu-items) (car (cdr menu-items))) tmp)
	(setq menu-items (cdr (cdr menu-items))))
      (mapcar (function (lambda (key&item) 
			  (apply (function define-key) menu key&item)))
	   tmp))
    menu)))
(defun load-se-eng/menu-map ()
  (interactive)
  (if (load "se-eng" 'noerror)
      (define-key se-doc/menu-map [english] '("English" . se-eng/menu-map))
    (message "se-eng was not found.")))
(defun load-se-jpn/menu-map ()
  (interactive)
  (if (load "se-jpn" 'noerror)
      (define-key se-doc/menu-map [japanese] '("Japanese" . se-jpn/menu-map))
      (define-key se-doc/menu-map [japanese] '("Japanese" . undefined))))

(define-menu-order se-doc/menu-map nil
  [english] '("Load English package" . load-se-eng/menu-map)
  [japanese] '("Load Japanese package" . load-se-jpn/menu-map)
  [shead]
  '("Beginning of sentence" . (lambda () (interactive) (se-doc/check-document se-doc/shead)))
  [stail]  
  '("End of sentence" . (lambda () (interactive) (se-doc/check-document se-doc/stail)))
  [paragraph]
  '("Paragraph" . (lambda () (interactive) (se-doc/check-document se-doc/paragraph)))
  [any]
  '("Regexp..." . (lambda () (interactive) (se-doc/check-document se-doc/any))))
(fset 'se-doc/menu-map (symbol-value 'se-doc/menu-map))


(define-key-after (lookup-key global-map
			      (if (< 20 emacs-major-version)
				  [menu-bar tools]
				  [menu-bar search]))
  [se:check-document]
  '("SE:check document" . se-doc/menu-map)
  t)
(provide 'se-doc)

;; se-doc.el ends here